home *** CD-ROM | disk | FTP | other *** search
/ Trading on the Edge / Trading On The Edge - CD-ROM Toolkit (Wayzata Technology)(2031)(1994).bin / pc / shared / freeman / gas.m < prev    next >
Text File  |  1994-01-11  |  11KB  |  314 lines
  1. BeginPackage["GeneticAlgorithms`"]
  2.  
  3. f::usage = "f[x]"
  4. flip::usage = "flip[x]"
  5. newGenerate::usage = "newGenerate[pmutate,keyPhrase,pop,numGens]"
  6. decodeBGA::usage = "decodeBGA[chromosome]"
  7. selectOne::usage = "selectOne[foldedFitnessList,fitTotal]"
  8. myXor::usage = "myXor[x,y]"
  9. mutateBGA::usage = "mutateBGA[pmute,allel]"
  10. crossOver::usage = "crossOver[pcross,pmutate,parent1,parent2]"
  11. initPop::usage = "initPop[psize,csize]"
  12. displayBest::usage = "displayBest[fitnessList,number2Print]"
  13. bga::usage = "bga[pcross,pmutate,popInitial,fitFunction,numGens,printNum]"
  14. sigmoid::usage = "sigmoid[x]"
  15. initXorPop::usage = "initXorPop[psize,csize,ioPairs]"
  16. decodeXorChrom::usage = "decodeXorChrom[chromosome]"
  17. gaNetFitness::usage = "gaNetFitness[hiddenWts,outputWts,ioPairVectors]"
  18. crossOverXor::usage = "crossOverXor[pcross,pmutate,parent1,parent2]"
  19. gaXor::usage = "gaXor[pcross,pmutate,popInitial,numReplace,ioPairs,numGens,printNum]"
  20. decodeXorGenotype::usage = "decodeXorGenotype[genotype]"
  21. encodeNetGa::usage = "encodeNetGa[weight,len]"
  22. randomPop::usage = "randomPop[psize,csize,ioPairs,numGens]"
  23.  
  24.  
  25. Begin["`Private`"]    (* begin the private context *)
  26.  
  27.  
  28. f[x_] := 1+Cos[x]/(1+0.01 x^2)
  29.  
  30.  
  31. flip[x_] := If[Random[]<=x,True,False]
  32.  
  33.  
  34. newGenerate[pmutate_,keyPhrase_,pop_,numGens_] :=
  35.   Module[{i,newPop,parent,diff,matches,
  36.             index,fitness},
  37.       newPop=pop;
  38.     For[i=1,i<=numGens,i++,
  39.       diff = Map[(keyPhrase-#)&,newPop];
  40.       matches = Map[Count[#,0]&,diff];
  41.       fitness = Max[matches];
  42.       index = Position[matches,fitness];
  43.       parent = newPop[[First[Flatten[index]]]];
  44.       Print["Generation ",i,": ",FromCharacterCode[parent],
  45.                   " Fitness= ",fitness];
  46.       newPop = Table[Map[mutateLetter[pmutate,#]&,parent],{100}];
  47.       ];  (* end of For *)
  48.      ];  (* end of Module *)  
  49.  
  50.  
  51. decodeBGA[chromosome_] :=
  52.   Module[{pList,lchrom,values,phenotype},
  53.     lchrom = Length[chromosome];
  54.         (* convert from binary to decimal *)
  55.     pList = Flatten[Position[chromosome,1] ];
  56.     values = Map[2^(lchrom-#)&,pList];
  57.     decimal = Apply[Plus,values];
  58.         (* scale to proper range *)
  59.     phenotype = decimal (0.07820136852394916911)-40;
  60.     Return[phenotype];
  61.       ];   (* end of Module *)
  62.  
  63.  
  64.  
  65. selectOne[foldedFitnessList_,fitTotal_] :=
  66.   Module[{randFitness,elem,index},
  67.       randFitness = Random[] fitTotal;
  68.       elem = Select[foldedFitnessList,#>=randFitness&,1];
  69.       index = 
  70.        Flatten[Position[foldedFitnessList,First[elem]]];
  71.       Return[First[index]];
  72.       ];  (* end of Module *)
  73.  
  74.  
  75. myXor[x_,y_] := If[x==y,0,1];
  76.  
  77.  
  78. mutateBGA[pmute_,allel_] := 
  79.     If[flip[pmute],myXor[allel,1],allel];
  80.  
  81.  
  82. crossOver[pcross_,pmutate_,parent1_,parent2_] :=
  83.   Module[{child1,child2,crossAt,lchrom },
  84.               (* chromosome length *)
  85.       lchrom = Length[parent1];
  86.     If[ flip[pcross],
  87.             (* True: select cross site at random *)
  88.         crossAt = Random[Integer,{1,lchrom-1}];
  89.             (* construct children  *)
  90.         child1 = Join[Take[parent1,crossAt], Drop[parent2,crossAt]];
  91.         child2 = Join[Take[parent2,crossAt],    Drop[parent1,crossAt]],            
  92.           (* False: return parents as children *)
  93.         child1 = parent1;
  94.         child2 = parent2;
  95.        ];  (* end of If *)
  96.           (* perform mutation *)
  97.      child1 = Map[mutateBGA[pmutate,#]&,child1];
  98.      child2 = Map[mutateBGA[pmutate,#]&,child2];
  99.      Return[{child1,child2}];
  100.      ];  (* end of Module *)
  101.  
  102.  
  103.  
  104. initPop[psize_,csize_] := 
  105.     Table[Random[Integer,{0,1}],{psize},{csize}];
  106.  
  107.  
  108. displayBest[fitnessList_,number2Print_] :=
  109.     Module[{i,sortedList},
  110.         sortedList = Sort[fitnessList,Greater];
  111.         For[i=1,i<=number2Print,i++,
  112.             Print["fitness = ",sortedList[[i]] ];
  113.             ]; (* end of For i *)
  114.         ];  (* end of Module *)
  115.  
  116.  
  117. bga[pcross_,pmutate_,popInitial_,fitFunction_,numGens_,printNum_] :=
  118.   Module[{i,newPop,parent1,parent2,diff,matches,
  119.             oldPop,reproNum,index,fitList,fitListSum,
  120.             fitSum,pheno,pIndex,pIndex2,f,children},
  121.       oldPop=popInitial;                 (* initialize first population *)
  122.       reproNum = Length[oldPop]/2;       (* calculate number of reproductions *)
  123.       f = fitFunction;                   (* assign the fitness function *)
  124.     For[i=1,i<=numGens,i++,           (* perform numGens generations *)
  125.       pheno = Map[decodeBGA,oldPop];  (* decode the chromosomes *)
  126.       fitList = f[pheno];                (* determine the fitness of each phenotype *)
  127.       Print[" "];                        (* print out the best individuals *)
  128.       Print["Generation ",i,"  Best ",printNum];
  129.       Print[" "];
  130.       displayBest[fitList,printNum];
  131.       fitListSum = FoldList[Plus,First[fitList],Rest[fitList]];
  132.       fitSum = Last[fitListSum];      (* find the total fitness *)
  133.       newPop = Flatten[Table[      (* determine the new population *)
  134.          pIndex1 = selectOne[fitListSum,fitSum];  (* select parent indices *)
  135.          pIndex2 = selectOne[fitListSum,fitSum];
  136.          parent1 = oldPop[[pIndex1]];        (* identify parents *)
  137.          parent2 = oldPop[[pIndex2]];
  138.          children = crossOver[pcross,pmutate,parent1,parent2]; (* crossover and mutate *)
  139.          children,{reproNum}],1     (* add children to list; flatten to first level *)
  140.          ];  (* end of Flatten[Table] *)
  141.         oldPop = newPop;             (* new becomes old for next gen *)
  142.       ];  (* end of For i*)
  143.      ];  (* end of Module *)     
  144.  
  145.  
  146.  
  147. sigmoid[x_] := 1./(1+E^(-x));
  148.  
  149.  
  150. initXorPop[psize_,csize_,ioPairs_] :=
  151.   Module[{i,iPop,hidWts,outWts,mseInv},
  152.                   (* first the chromosomes *)
  153.     iPop = Table[
  154.         {Table[Random[Integer,{0,1}],{csize}],(* h1 *)
  155.           Table[Random[Integer,{0,1}],{csize}],(* h2 *)
  156.           Table[Random[Integer,{0,1}],{csize}] (* o1 *)
  157.          },  {psize}  ]; (* end of Table *)
  158.                  (* then decode and eval fitness *)
  159.                  (* use For loop for clarity *)
  160.        For[i=1,i<=psize,i++,
  161.                    (* make hidden weight matrix *)
  162.             hidWts = Join[iPop[[i,1]],iPop[[i,2]] ];
  163.             hidWts = Partition[hidWts,20];
  164.             hidWts = Map[decodeXorChrom,hidWts];
  165.             hidWts = Partition[hidWts,2];
  166.                     (* make output weight matrix *)
  167.             outWts = Partition[iPop[[i,3]],20];
  168.             outWts = Map[decodeXorChrom,outWts];
  169.                     (* get mse for this network *)
  170.             mseInv = gaNetFitness[hidWts,outWts,ioPairs];
  171.                     (* prepend mseInv *)
  172.             PrependTo[iPop[[i]],mseInv];
  173.             ];  (* end For *)        
  174.      Return[iPop];
  175.      ];  (* end of Module *)
  176.  
  177.  
  178. decodeXorChrom[chromosome_] :=
  179.   Module[{pList,lchrom,values,p,decimal},
  180.     lchrom = Length[chromosome];
  181.         (* convert from binary to decimal *)
  182.     pList = Flatten[Position[chromosome,1] ];
  183.     values = Map[2^(lchrom-#)&,pList];
  184.     decimal = Apply[Plus,values];
  185.         (* scale to proper range *)
  186.     p = decimal (9.536752259018191355*10^-6)-5;
  187.     Return[p];
  188.       ];   (* end of Module *)
  189.  
  190.  
  191.  
  192. gaNetFitness[hiddenWts_,outputWts_,ioPairVectors_] :=
  193.   Module[{inputs,hidden,outputs,desired,errors,
  194.       len,errorTotal,errorSum},
  195.    inputs=Map[First,ioPairVectors];
  196.    desired=Map[Last,ioPairVectors];
  197.    len = Length[inputs];
  198.    hidden=sigmoid[inputs.Transpose[hiddenWts]];
  199.    outputs=sigmoid[hidden.Transpose[outputWts]];
  200.    errors= desired-outputs;
  201.    errorSum = Apply[Plus,errors^2,2]; (* second level *)
  202.    errorTotal = Apply[Plus,errorSum];
  203.            (* inverse of mse *)
  204.    Return[len/errorTotal];
  205.    ]                    (* end of Module *)        
  206.  
  207.  
  208. crossOverXor[pcross_,pmutate_,parent1_,parent2_] :=
  209.   Module[{child1,child2,crossAt,lchrom,
  210.               i,numchroms,chroms1,chroms2},
  211.               (* strip off mse *)
  212.       chroms1 = Rest[parent1];
  213.       chroms2 = Rest[parent2];
  214.               (* chromosome length *)
  215.       lchrom = Length[chroms1[[1]]];
  216.               (* number of chromosomes in each list *)
  217.       numchroms = Length[chroms1];
  218.       For[i=1,i<=numchroms,i++,     (* for each chrom *)
  219.       If[ flip[pcross],
  220.         crossAt = Random[Integer,{1,lchrom-1}]; (* True: select cross site at random *)
  221.             (* construct children  *)
  222.         chroms1[[i]] = Join[Take[chroms1[[i]],crossAt],Drop[chroms2[[i]],crossAt]];
  223.         chroms2[[i]] = Join[Take[chroms2[[i]],crossAt],    Drop[chroms1[[i]],crossAt]],            
  224.         Continue];   (* False: don't change chroms[[i]].  End of If *)
  225.           (* perform mutation *)
  226.         chroms1[[i]] =  Map[mutateBGA[pmutate,#]&,chroms1[[i]]];
  227.         chroms2[[i]] = Map[mutateBGA[pmutate,#]&,chroms2[[i]]];
  228.         ];  (* end of For i *)
  229.      Return[{chroms1,chroms2}];
  230.      ];  (* end of Module *)
  231.  
  232.  
  233.  
  234. gaXor[pcross_,pmutate_,popInitial_,numReplace_,ioPairs_,numGens_,printNum_] :=
  235.   Module[{i,j,newPop,parent1,parent2,diff,matches,
  236.             oldPop,reproNum,index,fitList,fitListSum,
  237.             fitSum,pheno,pIndex,pIndex2,f,children,hids,outs,mseInv},
  238.                 (* initialize first population sorted by fitness value  *)
  239.       oldPop= Sort[popInitial,Greater[First[#],First[#2]]&];
  240.       reproNum = numReplace;       (* calculate number of reproductions *)
  241.      For[i=1,i<=numGens,i++,
  242.       fitList = Map[First,oldPop];    (* list of fitness values*) 
  243.                                                (* make the folded list of fitness values *)
  244.       fitListSum = FoldList[Plus,First[fitList],Rest[fitList]];
  245.       fitSum = Last[fitListSum];      (* find the total fitness *)
  246.       newPop = Drop[oldPop,-reproNum]; (* new population; eliminate reproNum worst *)
  247.       For[j=1,j<=reproNum/2,j++,       (* make reproNum new children *)
  248.                   (* select parent indices *)
  249.           pIndex1 = selectOne[fitListSum,fitSum];
  250.           pIndex2 = selectOne[fitListSum,fitSum];
  251.           parent1 = oldPop[[pIndex1]];    (* identify parents *)
  252.           parent2 = oldPop[[pIndex2]];
  253.           children = crossOverXor[pcross,pmutate,parent1,parent2];(*cross and mutate*)
  254.         {hids,outs} = decodeXorGenotype[children[[1]] ]; (* fitness of children *)
  255.         mseInv = gaNetFitness[hids,outs,ioPairs];
  256.         children[[1]] = Prepend[children[[1]],mseInv];
  257.         {hids,outs} = decodeXorGenotype[children[[2]] ];
  258.         mseInv = gaNetFitness[hids,outs,ioPairs];
  259.         children[[2]] = Prepend[children[[2]],mseInv];
  260.         newPop = Join[newPop,children]; (* add children to new population *)
  261.         ];  (* end of For j *)
  262.         oldPop =    Sort[newPop,Greater[First[#],First[#2]]&];(* for next gen *)
  263.                 (* print best mse values (1/mseInv) *)
  264.         Print[ ];Print["Best of generation ",i];
  265.         For[j=1,j<=printNum,j++,Print[(1.0/oldPop[[j,1]])]; ];
  266.       ];  (* end of For i*)
  267.      Return[oldPop];
  268.      ];  (* end of Module *)     
  269.  
  270.  
  271.  
  272. decodeXorGenotype[genotype_] :=
  273.       Module[{hidWts,outWts}, 
  274.             hidWts = Join[genotype[[1]],genotype[[2]] ];
  275.             hidWts = Partition[hidWts,20];
  276.             hidWts = Map[decodeXorChrom,hidWts];
  277.             hidWts = Partition[hidWts,2];
  278.                     (* make output weight matrix *)
  279.             outWts = Partition[genotype[[3]],20];
  280.             outWts = Map[decodeXorChrom,outWts];
  281.             Return[{hidWts,outWts}];
  282.             ];
  283.  
  284.  
  285. encodeNetGa[weight_,len_] :=
  286.   Module[{pList,values,dec,chromosome,i},
  287.       i=len;
  288.       l=Table[0,{i}];
  289.         (* scale to proper range *)
  290.     dec = Round[(weight+5.)/(9.536752259018191355*10^-6)];
  291.     While[dec!=0&&dec!=1,
  292.       l=ReplacePart[l,Mod[dec,2],i];
  293.       dec=Quotient[dec,2];
  294.       --i;
  295.       ];
  296.    l=ReplacePart[l,dec,i] 
  297.       ];   (* end of Module *)
  298.  
  299.  
  300. randomPop[psize_,csize_,ioPairs_,numGens_] :=
  301.   Module[{i,pop},
  302.      For[i=1,i<=numGens,i++,
  303.        pop = initXorPop[psize,csize,ioPairs];
  304.        pop = Sort[pop,Greater[First[#],First[#2]]&];
  305.        Print[ ];
  306.        Print["Random generation ",i];
  307.        Print[(1.0/pop[[1,1]])];
  308.        ];
  309.      ];
  310.  
  311.  
  312. End[]         (* end the private context *)
  313.  
  314. EndPackage[]  (* end the package context *)